home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / SPREADST / LOTUS2 / FILE_LIB.PAS < prev    next >
Pascal/Delphi Source File  |  1992-09-04  |  5KB  |  184 lines
  1. {$F+,O+}
  2. UNIT File_Lib;
  3. INTERFACE
  4.   function File_Exist (File_Name : string) : boolean;
  5.  
  6.   function Find_File_Along_Path (File_Name : string) : string;
  7.  
  8.                             {* Assumes path ends with a '/'   *}
  9.   procedure Check_Valid_Path (Path_To_Ck     : string;
  10.                               VAR Ret_Status : integer);
  11.  
  12.   function Get_Unique_FileName : string;
  13.  
  14.   procedure Erase_File (File_Name  : string;
  15.                         Var Status : byte);
  16.   {* erase MANY files *}
  17.   procedure Erase_Wild_Files (File_Name_Mask : string);
  18.  
  19.   function File_Error (Err : word) : string;
  20.   function File_Error_This_File (File_Name : string) : string;
  21.  
  22. IMPLEMENTATION
  23. USES
  24.   Line_Collection,
  25.   Str_Stf,
  26.   DOS;
  27.  
  28. {***********************************************************************}
  29. function File_Exist (File_Name : string) : boolean;
  30. var
  31.   DirInfo  : DOS.SearchRec;
  32. begin
  33.   DOS.FindFirst (File_Name, DOS.AnyFile, DirInfo);
  34.  
  35.   IF (DOS.DosError = 0)
  36.     THEN File_Exist := TRUE
  37.     ELSE File_Exist := FALSE;
  38. end; {File_Exist}
  39.  
  40. {***********************************************************************}
  41. function Find_File_Along_Path (File_Name : string) : string;
  42. begin
  43.   {*------------------------------------------------------------*}
  44.   {* Ok, Must check for file along the current PATH             *}
  45.   {* Starting with the current path                             *}
  46.   {*------------------------------------------------------------*}
  47.   Find_File_Along_Path := DOS.FSearch (File_Name, DOS.GetEnv('PATH'));
  48. end; {Find_File_Along_Path}
  49.  
  50.  
  51.  
  52.  
  53.  
  54. {***********************************************************************}
  55. {* Assumes path ends with a '/'   *}
  56. procedure Check_Valid_Path (Path_To_Ck     : string;
  57.                             VAR Ret_Status : integer);
  58. var
  59.   Curr_Path : string;
  60.   Dir       : DOS.DirStr;
  61.   Ext       : DOS.ExtStr;
  62.   Name      : DOS.NameStr;
  63.   Temp_Str  : string;
  64. begin
  65.   Ret_Status := 0;
  66.   Temp_Str := TRIM (Path_To_Ck);
  67.   IF (Temp_Str = '')
  68.     THEN Ret_Status := -1
  69.   ELSE
  70.     BEGIN
  71.       Temp_Str := DOS.FExpand (Temp_Str);
  72.       DOS.FSplit (Temp_Str, Dir, Name, Ext);
  73.       IF ((Name <> '') or (Ext <> ''))
  74.         THEN Ret_Status := -2
  75.       ELSE IF (POS (':', Dir) <> 2)
  76.         THEN Ret_Status := -3
  77.       ELSE IF ((POS ('\', Dir) <> 3))
  78.         THEN Ret_Status := -4
  79.       ELSE
  80.         BEGIN {* Looks ok, check if directory exists *}
  81.           GetDir (0, Curr_Path);
  82.           DEC(Temp_Str[0]); {cut off last '\'}
  83.           {$I-} ChDir (Temp_Str); {$I+}
  84.           IF (IoResult <> 0)
  85.             THEN Ret_Status := -5;
  86.           ChDir (Curr_Path);
  87.         END;
  88.     END; {if}
  89. end;  {Check_Valid_Path}
  90.  
  91.  
  92. {***********************************************************************}
  93. function Get_Unique_FileName : string;
  94. var
  95.   T_Hr, T_Min, T_Sec, T_100 : word;
  96. begin
  97.   DOS.GetTime (T_Hr, T_Min, T_Sec, T_100);
  98.   Get_Unique_FileName := Int_To_Str(T_Hr)+Int_To_Str(T_Min)+
  99.                          Int_To_Str(T_Sec)+Int_To_Str(T_100);
  100. end; {get_unique_filename}
  101.  
  102. {***********************************************************************}
  103. procedure Erase_File (File_Name  : string;
  104.                       Var Status : byte);
  105. VAR
  106.   f : file;
  107. begin
  108.   Status := 0;
  109.   Assign (F, File_Name);
  110.   {$I-} Reset (F); {I+}
  111.   IF (IOResult = 0) THEN
  112.     BEGIN
  113.       {$I-}
  114.       Close (F);
  115.       Erase (F);
  116.       {$I+}
  117.       IF (IOResult <> 0)
  118.         THEN Status := 2;
  119.     END
  120.   ELSE Status := 1;
  121. end; {erase_file}
  122.  
  123. {***********************************************************************}
  124. function File_Error (Err : word) : string;
  125. begin
  126.   CASE Err OF
  127.     0: File_Error := '';      {no error}
  128.     2: File_Error := ' File Not Found';
  129.     3: File_Error := ' Path Not Found';
  130.     4: File_Error := ' Too many open files (Need more FILE=# in CONFIG.SYS)';
  131.     5: File_Error := ' File Access Denied'
  132.   ELSE
  133.     File_Error := ' Some File error';
  134.   END;
  135. end; {file_error}
  136.  
  137. {***********************************************************************}
  138. function File_Error_This_File (File_Name : string) : string;
  139. var
  140.   t     : file;
  141.   Reply : word;
  142. begin
  143.   assign (T, File_Name);
  144.   {$I-} ReSet(T);
  145.   File_Error_This_File := File_Error (IOResult);
  146.   Close (T);
  147.   {$I+}
  148.   Reply := IOResult;
  149. end; {file_error_this_File}
  150.  
  151. {***********************************************************************}
  152. procedure Erase_Wild_Files (File_Name_Mask : string);
  153. var
  154.   DirInfo              : DOS.SearchRec;
  155.   File_Name            : string;
  156.   File_Names           : PMany_Line_Sort_Collection;
  157.   i                    : integer;
  158.   Status               : byte;
  159. begin
  160.   File_Names := NEW (PMany_Line_Sort_Collection, INIT (30,5));
  161.  
  162.   DOS.FindFirst (File_Name_Mask, DOS.AnyFile, DirInfo);
  163.  
  164.   WHILE (DOS.DosError = 0) DO
  165.   BEGIN
  166.     File_Names^.Over_Write (New(PStrSort_Record,
  167.                                            Init(DirInfo.Name,
  168.                                                 DirInfo.Name, '')));
  169.     DOS.FindNext (DirInfo);
  170.   END; {while}
  171.  
  172.   FOR i := 0 to (File_Names^.Count-1) DO
  173.   BEGIN
  174.     File_Name := PStrSort_Record(File_Names^.At(I))^.Lines[1]^;
  175.     Erase_File (File_Name, Status);
  176.   END; {for}
  177.  
  178.   Dispose (File_Names, DONE);
  179.  
  180. end; {Erase_Wild_Files}
  181.  
  182.  
  183.  
  184. end. {unit File_Lib}